home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / examples.lha / Examples / Libraries / GadTools / GadToolsMenu.mod next >
Encoding:
Text File  |  1995-07-02  |  4.8 KB  |  189 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: GadToolsMenu.mod $
  4.   Description: Example illustrating the use of GadTools menus.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.5 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/25 23:49:09 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This example program is part of Oberon-A.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18.  
  19. MODULE GadToolsMenu;
  20.  
  21. IMPORT
  22.   SYS := SYSTEM,
  23.   e   := Exec,
  24.   u   := Utility,
  25.   i   := Intuition,
  26.   gt  := GadTools;
  27.  
  28. CONST
  29.   VersionTag = "$VER: GadToolsMenu 1.2 (23.1.95)\r\n";
  30.  
  31. VAR
  32.  
  33.   mynewmenu : ARRAY 16 OF gt.NewMenu;
  34.  
  35. (*------------------------------------*)
  36. PROCEDURE Init ();
  37.  
  38. BEGIN (* Init *)
  39.   (* Making the assumption that unitialised fields are zeroed... *)
  40.  
  41.   mynewmenu[0].type := gt.title;
  42.   mynewmenu[0].label := SYS.ADR ("Project");
  43.  
  44.   mynewmenu[1].type := gt.item;
  45.   mynewmenu[1].label := SYS.ADR ("Open...");
  46.   mynewmenu[1].commKey := SYS.ADR ("O");
  47.  
  48.   mynewmenu[2].type := gt.item;
  49.   mynewmenu[2].label := SYS.ADR ("Save");
  50.   mynewmenu[2].commKey := SYS.ADR ("S");
  51.  
  52.   mynewmenu[3].type := gt.item;
  53.   mynewmenu[3].label := gt.barLabel;
  54.  
  55.   mynewmenu[4].type := gt.item;
  56.   mynewmenu[4].label := SYS.ADR ("Print");
  57.  
  58.   mynewmenu[5].type := gt.sub;
  59.   mynewmenu[5].label := SYS.ADR ("Draft");
  60.  
  61.   mynewmenu[6].type := gt.sub;
  62.   mynewmenu[6].label := SYS.ADR ("NLQ");
  63.  
  64.   mynewmenu[7].type := gt.item;
  65.   mynewmenu[7].label := gt.barLabel;
  66.  
  67.   mynewmenu[8].type := gt.item;
  68.   mynewmenu[8].label := SYS.ADR ("Quit...");
  69.   mynewmenu[8].commKey := SYS.ADR ("Q");
  70.  
  71.   mynewmenu[9].type := gt.title;
  72.   mynewmenu[9].label := SYS.ADR ("Edit");
  73.  
  74.   mynewmenu[10].type := gt.item;
  75.   mynewmenu[10].label := SYS.ADR ("Cut");
  76.   mynewmenu[10].commKey := SYS.ADR ("X");
  77.  
  78.   mynewmenu[11].type := gt.item;
  79.   mynewmenu[11].label := SYS.ADR ("Copy");
  80.   mynewmenu[11].commKey := SYS.ADR ("C");
  81.  
  82.   mynewmenu[12].type := gt.item;
  83.   mynewmenu[12].label := SYS.ADR ("Paste");
  84.   mynewmenu[12].commKey := SYS.ADR ("V");
  85.  
  86.   mynewmenu[13].type := gt.item;
  87.   mynewmenu[13].label := gt.barLabel;
  88.  
  89.   mynewmenu[14].type := gt.item;
  90.   mynewmenu[14].label := SYS.ADR ("Undo");
  91.   mynewmenu[14].commKey := SYS.ADR ("Z");
  92.  
  93.   mynewmenu[15].type := gt.end;
  94. END Init;
  95.  
  96. (*------------------------------------
  97. ** Watch the menus and wait for the user to select the close gadget
  98. ** or quit from the menus.
  99. *)
  100. PROCEDURE HandleWindowEvents (win : i.WindowPtr; menuStrip : i.MenuPtr);
  101.  
  102.   VAR
  103.     msg : i.IntuiMessagePtr;
  104.     done : BOOLEAN;
  105.     menuNumber : INTEGER;
  106.     menuNum : INTEGER;
  107.     itemNum : INTEGER;
  108.     subNum : INTEGER;
  109.     item : i.MenuItemPtr;
  110.     signals : SET;
  111.  
  112. BEGIN (* HandleWindowEvents *)
  113.   done := FALSE;
  114.   WHILE ~done DO
  115.     (* We only have one signal bit, so we do not have to check which
  116.     ** bit broke the Wait().
  117.     *)
  118.     signals := e.Wait ({win.userPort.sigBit});
  119.     LOOP
  120.       IF done THEN EXIT END;
  121.       msg := SYS.VAL (i.IntuiMessagePtr, e.GetMsg (win.userPort));
  122.       IF msg = NIL THEN EXIT END;
  123.       IF msg.class = {i.closeWindow} THEN
  124.         done := TRUE
  125.       ELSIF msg.class = {i.menuPick} THEN
  126.         menuNumber := msg.code;
  127.         WHILE (menuNumber # i.menuNull) & ~done DO
  128.           item := i.ItemAddress (menuStrip^, menuNumber);
  129.  
  130.           (* Process the item here *)
  131.           menuNum := i.MenuNum (menuNumber);
  132.           itemNum := i.ItemNum (menuNumber);
  133.           subNum := i.SubNum (menuNumber);
  134.  
  135.           (* stop if quit is selected *)
  136.           IF (menuNum = 0) & (itemNum = 5) THEN
  137.             done := TRUE
  138.           END;
  139.  
  140.           menuNumber := item.nextSelect
  141.         END
  142.       END;
  143.       e.ReplyMsg (msg)
  144.     END
  145.   END
  146. END HandleWindowEvents;
  147.  
  148. (*------------------------------------*)
  149. PROCEDURE Main ();
  150.  
  151.   VAR
  152.     win : i.WindowPtr;
  153.     myVisualInfo : gt.VisualInfo;
  154.     menuStrip : i.MenuPtr;
  155.  
  156. BEGIN (* Main *)
  157.   IF i.base.libNode.version >= 37 THEN
  158.     ASSERT (gt.base # NIL, 100);
  159.     win := i.OpenWindowTagsA
  160.       ( NIL,
  161.         i.waWidth,  400, i.waActivate, e.LTRUE,
  162.         i.waHeight, 100, i.waCloseGadget, e.LTRUE,
  163.         i.waTitle,  SYS.ADR ("Menu Test Window"),
  164.         i.waIDCMP,  {i.closeWindow, i.menuPick},
  165.         u.end );
  166.     IF win # NIL THEN
  167.       myVisualInfo := gt.GetVisualInfo (win.wScreen, u.end);
  168.       IF myVisualInfo # NIL THEN
  169.         menuStrip := gt.CreateMenus (mynewmenu, u.end);
  170.         IF menuStrip # NIL THEN
  171.           IF gt.LayoutMenus (menuStrip, myVisualInfo, u.end) THEN
  172.             IF i.SetMenuStrip (win, menuStrip^) THEN
  173.               HandleWindowEvents (win, menuStrip);
  174.               i.ClearMenuStrip (win)
  175.             END;
  176.             gt.FreeMenus (menuStrip)
  177.           END;
  178.         END;
  179.         i.CloseWindow (win)
  180.       END;
  181.     END;
  182.   END;
  183. END Main;
  184.  
  185. BEGIN (* GadToolsMenu *)
  186.   Init ();
  187.   Main ();
  188. END GadToolsMenu.
  189.